home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / S / MOUSE.S < prev    next >
Encoding:
Text File  |  1993-10-24  |  21.7 KB  |  437 lines
  1. ; MOUSE.S
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Scheme code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*        Microsoft-Compatible Mouse Interface            *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: L. Bartholdi        Date: 19930929            *
  16. ;* Revision history:                            *
  17. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18. ;*                                    *
  19. ;*                    ``In nomine omnipotentii dei''    *
  20. ;************************************************************************
  21. (if (unbound? mouse)
  22. (set! (access mouse user-global-environment)
  23.   (let* ((mask->buttons
  24.        (lambda (word)
  25.          (apply append
  26.             (list (if (= 0 (bitwise-and word 1)) '() '(LEFT))
  27.               (if (= 0 (bitwise-and word 2)) '() '(RIGHT))
  28.               (if (= 0 (bitwise-and word 4)) '() '(CENTER))))))
  29.      (pair!
  30.        (lambda (p)
  31.          (if (and (pair? p)
  32.               (char? (car p)))
  33.          (- (remainder (+ #x8000
  34.                   (* #x100 (fixnum! (cdr p)))
  35.                   (char->integer (car p)))
  36.                    #x10000)
  37.             #x8000)
  38.          (error "Mouse error: (char . short) expected" p))))
  39.      (bitmap!
  40.        (lambda (l)
  41.          (if (and (list? l)
  42.               (eq? (length l) #x10))
  43.          (apply string-append
  44.             (map (lambda (x) (list->string
  45.                        (list (integer->char (remainder x #x100))
  46.                          (integer->char (quotient x #x100)))))
  47.                  l))
  48.          (error "Mouse error: #x10-element list expected" l))))
  49.      (button!
  50.        (lambda (b)
  51.          (let ((num (assq b '((LEFT . 0)
  52.                   (RIGHT . 1)
  53.                   (CENTER . 2)))))
  54.            (if num
  55.            (cdr num)
  56.            (error "Mouse error: 'LEFT, 'RIGHT or 'CENTER expected" b)))))
  57.      (match!
  58.        (lambda (predicate x)
  59.          (if (predicate x) x (error "Mouse error: predicate failed" (list predicate x)))))
  60.      (fixnum!
  61.        (lambda (x)
  62.          (if (and (integer? x) (>= x (- #x8000)) (< x #x8000))
  63.          x
  64.          (error "Mouse error: short expected" x))))
  65.      (mouse-error
  66.        (lambda (s)
  67.          (error "Scheme-Mouse error" s)))
  68.      (event-list '((MOVE .        #x0001)
  69.                (LEFT-DOWN .    #x0002)
  70.                (LEFT-UP .    #x0004)
  71.                (LEFT .        #x0006)
  72.                (RIGHT-DOWN .    #x0008)
  73.                (RIGHT-UP .    #x0010)
  74.                (RIGHT .        #x0018)
  75.                (CENTER-DOWN .    #x0120)
  76.                (CENTER-UP .    #x0240)
  77.                (CENTER .    #x0360)
  78.                (DOWN .        #x002a)
  79.                (UP .        #x0054)
  80.                (BUTTONS .    #x007e)))
  81.      (event!
  82.        (lambda (e)
  83.          (let ((v (assq e event-list)))
  84.            (if v (cdr v) (error "Mouse error: unknown event" e)))))
  85.      (mask->events
  86.        (lambda (word)
  87.          (apply append (map    (lambda (x)
  88.                   (if (<> (bitwise-and word (cdr x)) 0)
  89.                       (list (car x))
  90.                       ()))
  91.                 event-list))
  92.        ))
  93.  
  94.      (mouse-handler
  95.        (lambda l
  96.          (error "Mouse error: null mouse handler called" l)))
  97.      (sleeping #T)
  98.      (mouse-queue '())
  99.      (version (lambda (word)
  100.             (+ (quotient word #x100)
  101.                (/ (bitwise-and word #xf0) 160.0)
  102.                (/ (bitwise-and word #x0f) 100.0))))
  103.      (query '())
  104.      (jobs `((ENABLE . ,(lambda ()
  105.                   (set! sleeping #T)    ; so we can wake up
  106.                   (mouse 'TRIGGER '())    ; and really wake up
  107.                 ))
  108.          (DISABLE . ,(lambda ()
  109.                    (set! sleeping #F)))    ; cut everything off
  110.                 ; they'll have to be re-enabled manually
  111.          (TRIGGER . ,(lambda (new-events)
  112.                    (set! mouse-queue (append! new-events mouse-queue))
  113.                    (when sleeping
  114.                  (set! sleeping #F)
  115.                  (let loop ((last (car (last-pair mouse-queue))))
  116.                    (when (and mouse-queue (not sleeping))
  117.                      (set! mouse-queue (delete! last mouse-queue))
  118.                      (apply mouse-handler (list* (mask->events (car last))
  119.                                  (mask->buttons (cadr last))
  120.                                  (cddr last)))
  121.                      (loop (car (last-pair mouse-queue)))))
  122.                  (set! sleeping #T))))
  123.          (CURSOR . ,(lambda (name)
  124.                   (set! query (match! symbol? name))
  125.                   (fast-load (%system-file-name "MOUSE.FSL"))
  126.                   (begin0
  127.                 (if (null? query)
  128.                     (%error-invalid-operand 'mouse name)
  129.                     (cdr query))
  130.                 (set! query '()))))
  131.          (SMOOTH . ,(lambda (message . args)
  132.                   (case message
  133.                 (CHECK (let ((result (%mouse #x3000)))
  134.                      (if (= (car result) -1)
  135.                          (version (cadr result))
  136.                          #F)))
  137.                 (ENABLE (if (= (car (%mouse #x3001)) 1)
  138.                         *the-non-printing-object*
  139.                         'FAILED))
  140.                 (DISABLE (if (= (car (%mouse #x3002)) 1)
  141.                         'FAILED
  142.                         *the-non-printing-object*)))))
  143.          (RESET . ,(lambda ()
  144.                  (%mouse -1 1)        ; set use flag
  145.                  (set! sleeping #T)        ; so we're ready to wake up
  146.                  (set! mouse-queue '())
  147.                  (let ((result (%mouse 0)))
  148.                    (if (= (car result) -1)
  149.                    (cadr result)
  150.                    #F))))
  151.          (SHOW . ,(lambda ()
  152.                 (%mouse 1)
  153.                 *the-non-printing-object*))
  154.          (HIDE . ,(lambda ()
  155.                 (%mouse 2)
  156.                 *the-non-printing-object*))
  157.          (INQ . ,(lambda ()
  158.                (let ((result (%mouse 3)))
  159.                  (cons (mask->buttons (cadr result))
  160.                    (cddr result)))))
  161.          (MOVE . ,(lambda (x y)
  162.                 (%mouse 4 0 (fixnum! x) (fixnum! y))
  163.                 *the-non-printing-object*))
  164.          (PRESS . ,(lambda (button)
  165.                  (let ((result (%mouse 5 (button! button))))
  166.                    (cons (mask->buttons (car result))
  167.                      (cdr result)))))
  168.          (RELEASE . ,(lambda (button)
  169.                    (let ((result (%mouse 6 (button! button))))
  170.                  (cons (mask->buttons (car result))
  171.                        (cdr result)))))
  172.          (LIMITS . ,(lambda (direction low high . rest)
  173.                   (fixnum! low)
  174.                   (fixnum! high)
  175.                   (case direction
  176.                 (HORIZONTAL (match! null? rest) (%mouse 7 0 low high))
  177.                 (VERTICAL (match! null? rest) (%mouse 8 0 low high))
  178.                 (BOTH (match! null? (cddr rest))
  179.                       (%mouse 7 0 low high)
  180.                       (%mouse 8 0 (fixnum! (car rest)) (fixnum! (cadr rest))))
  181.                 (else (%error-invalid-operand 'mouse direction)))
  182.                   *the-non-printing-object*))
  183.          (SHAPE . ,(lambda (l)        ; (hot-x hot-y and-buffer xor-buffer)
  184.                  (if (symbol? l)
  185.                  (mouse 'SHAPE (mouse 'CURSOR l))
  186.                  (begin
  187.                    (match! null? (cddddr l))
  188.                    (%mouse 9 (fixnum! (car l)) (fixnum! (cadr l)) 0 0 0
  189.                        (string-append (bitmap! (caddr l))
  190.                               (bitmap! (cadddr l))))))
  191.                  *the-non-printing-object*))
  192.          (TEXT-TYPE . ,(lambda (type and-mask xor-mask)
  193.                  (case type
  194.                    (SOFTWARE (%mouse 10 0 (pair! and-mask) (pair! xor-mask)))
  195.                    (HARDWARE (%mouse 10 1 (fixnum! and-mask) (fixnum! xor-mask)))
  196.                    (else (%error-invalid-operand 'mouse type)))
  197.                  *the-non-printing-object*))
  198.          (MICKEYS . ,(lambda ()
  199.                    (cddr (%mouse 11))))
  200.          (HANDLER . ,(lambda (l)
  201.                    (let ((old-proc mouse-handler)
  202.                      (result (%mouse 20 0 (apply bitwise-or (map event! (car l))) 0 0 0 '())))
  203.                  (set! mouse-handler (match! closure? (cdr l)))
  204.                  (cons (mask->events (caddr result))
  205.                        old-proc))))
  206.          (PEN-ON . ,(lambda ()
  207.                   (%mouse 13)
  208.                   *the-non-printing-object*))
  209.          (PEN-OFF . ,(lambda ()
  210.                    (%mouse 14)
  211.                    *the-non-printing-object*))
  212.          (MICKEY-RATIO . ,(lambda (x y)
  213.                     (%mouse 15 0 (fixnum! x) (fixnum! y))
  214.                     *the-non-printing-object*))
  215.          (EXCLUDE . ,(lambda (x0 x1 y0 y1)
  216.                    (%mouse 16 0 (fixnum! x0) (fixnum! y0) (fixnum! x1) (fixnum! y1))
  217.                    *the-non-printing-object*))
  218.          (SPEED-THRESHOLD . ,(lambda (speed)
  219.                        (%mouse 19 0 0 (fixnum! speed))
  220.                        *the-non-printing-object*))
  221.          (SENSITIVITY . ,(lambda l
  222.                    (if (= (length l) 3)
  223.                        (%mouse 26 (fixnum! (car l)) (fixnum! (cadr l)) (fixnum! (caddr l))))
  224.                    (cdr (%mouse 27))))
  225.          (INTERRUPT-RATE . ,(lambda (rate)
  226.                       (let ((word (assq rate '((NONE . 0)
  227.                                    (30 . 1)
  228.                                    (50 . 2)
  229.                                    (100 . 3)
  230.                                    (200 . 4)))))
  231.                     (if word
  232.                         (%mouse 28 (cdr word))
  233.                         (%error-invalid-operand 'mouse rate))
  234.                     *the-non-printing-object*)))
  235.          (POINTER-PAGE . ,(lambda l
  236.                     (if (= (length l) 1)
  237.                     (%mouse 29 (fixnum! (car l))))
  238.                     (cadr (%mouse 30))))
  239.          (LANGUAGE . ,(let ((languages '((ENGLISH . 0)
  240.                          (FRENCH . 1)
  241.                          (DUTCH . 2)
  242.                          (GERMAN . 3)
  243.                          (SWEDISH . 4)
  244.                          (FINNISH . 5)
  245.                          (SPANISH . 6)
  246.                          (PORTUGESE . 7)
  247.                          (ITALIAN . 8))))
  248.                 (lambda l
  249.                   (if (= (length l) 1)
  250.                       (let ((language (assq (car l) languages)))
  251.                     (if language
  252.                         (%mouse 34 (cdr language))
  253.                         (%error-invalid-operand 'mouse language (car l)))))
  254.                   (car (assq (%mouse 35) (map (lambda (l) (cons (cdr l) (car l)))
  255.                                   languages))))))
  256.          (INFORMATION . ,(lambda ()
  257.                    (let ((result (%mouse 36)))
  258.                      (list (version (cadr result))
  259.                        (vector-ref #(() BUS SERIAL INPORT PS/2 HP)
  260.                                (quotient (caddr result) #x100))
  261.                        (remainder (caddr result) #x100)))))
  262.         )                    ; job-list
  263.      )                        ; jobs
  264.      (query '())
  265.     )                        ; locals
  266.     (lambda args
  267.       (let ((task (assq (car args) jobs)))
  268.     (if task
  269.         (apply (cdr task) (cdr args))
  270.         (%error-invalid-operand 'mouse (car args)))))))
  271. )
  272.  
  273. (let ((symbol (access query (procedure-environment mouse)))
  274.       (cursors '(
  275.  
  276. ; the following are from the X Windows shared libraries
  277. ; (openwin/share/lib/include/bitmaps)
  278. ; reproduced without permission (lb).
  279.  
  280. (CENTER . (7 0
  281.   (#xfc3f #xfc3f #xf81f #xf81f #xf00f #xf00f #xe007 #xe007 #xc003 #xc003 #xc003 #xc423 #xfc3f #xfc3f #xfc3f #xfc3f)
  282.   (#x0000 #x0180 #x0180 #x03c0 #x03c0 #x07e0 #x07e0 #x0ff0 #x0ff0 #x1998 #x1188 #x0180 #x0180 #x0180 #x0180 #x0000)))
  283. (KEYBOARD . (7 7
  284.   (#xffff #xffff #xf00f #xeff7 #xeff7 #xeff7 #xeff7 #xf00f #xffff #xffff #xf00f #xeaa7 #xd553 #xc003 #xffff #xffff)
  285.   (#x0000 #x0000 #x0ff0 #x1008 #x1008 #x1008 #x1008 #x0ff0 #x0000 #x0000 #x0ff0 #x1558 #x2aac #x3ffc #x0000 #x0000)))
  286. (LEFT . (2 0
  287.   (#xcfff #xc7ff #xc3ff #xc1ff #xc0ff #xc07f #xc03f #xc01f #xc00f #xc00f #xc07f #xc43f #xcc3f #xfe1f #xfe1f #xff3f)
  288.   (#x0000 #x1000 #x1800 #x1c00 #x1e00 #x1f00 #x1f80 #x1fc0 #x1fe0 #x1f00 #x1b00 #x1180 #x0180 #x00c0 #x00c0 #x0000)))
  289. (RIGHT . (13 0
  290.   (#xfff3 #xffe3 #xffc3 #xff83 #xff03 #xfe03 #xfc03 #xf803 #xf003 #xf003 #xfe03 #xfc23 #xfc33 #xf87f #xf87f #xfcff)
  291.   (#x0000 #x0008 #x0018 #x0038 #x0078 #x00f8 #x01f8 #x03f8 #x07f8 #x00f8 #x00d8 #x0188 #x0180 #x0300 #x0300 #x0000)))
  292. (STAR6 . (7 7
  293.   (#xfc7f #xfc7f #xc447 #xc007 #xc007 #xe00f #x0001 #x0001 #x0001 #xe00f #xc007 #xc007 #xc447 #xfc7f #xfc7f #xffff)
  294.   (#x0000 #x0100 #x0100 #x1110 #x0920 #x0540 #x0280 #x7c7c #x0280 #x0540 #x0920 #x1110 #x0100 #x0100 #x0000 #x0000)))
  295. (TARGET . (7 7
  296.   (#xffff #xfe7f #xfe7f #xf81f #xf66f #xee77 #xec37 #x8181 #x8181 #xec37 #xee77 #xf66f #xf81f #xfe7f #xfe7f #xffff)
  297.   (#x0000 #x0180 #x0180 #x07e0 #x0990 #x1188 #x13c8 #x7e7e #x7e7e #x13c8 #x1188 #x0990 #x07e0 #x0180 #x0180 #x0000)))
  298.  
  299. ; the following are from a package called `PP111.ZIP', so-called Precise-Point.
  300. ; they are also reproduced without permission.
  301. (ARROW . (0 0
  302.   (#xbfff #x1fff #x0fff #x07ff #x03ff #x01ff #x00ff #x01ff #x03ff #xb1ff #xf1ff #xf8ff #xfdff #xffff #xffff #xffff)
  303.   (#x0000 #x4000 #x6000 #x5000 #x6800 #x5400 #x5200 #x4800 #x4800 #x0400 #x0400 #x0200 #x0000 #x0000 #x0000 #x0000)))
  304. (BLOCK . (4 7
  305.   (#x807f #x003f #x003f #x003f #x003f #x003f #x003f #x003f #x003f #x003f #x003f #x003f #x003f #x003f #x003f #x807f)
  306.   (#x0000 #x7f80 #x7f80 #x7f80 #x7f80 #x7f80 #x7f80 #x7f80 #x7f80 #x7f80 #x7f80 #x7f80 #x7f80 #x7f80 #x7f80 #x0000)))
  307. (CIRCLE . (2 2
  308.   (#xcfff #x87ff #x03ff #x03ff #x87ff #xcfff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  309.   (#x0000 #x3000 #x4800 #x4800 #x3000 #x0000 #x0000 #x0000 #x0000 #x0000 #x0000 #x0000 #x0000 #x0000 #x0000 #x0000)))
  310. (EXCLAIM . (0 14
  311.   (#xffe1 #xffc0 #xff80 #xff00 #xfe01 #xfc03 #xfc07 #xf80f #xf01f #xf07f #xe0ff #xc1ff #x87ff #x07ff #x0fff #x9fff)
  312.   (#x0000 #x001e #x003e #x007e #x00fc #x01f8 #x01f0 #x03e0 #x0780 #x0700 #x0e00 #x0000 #x3000 #x7000 #x6000 #x0000)))
  313. (HAND . (5 1
  314.   (#xffff #xffff #xfbff #xfbff #xfbff #xfabf #xfaaf #xeaaf #xc0af #xc00f #xc00f #xc00f #xc00f #xe01f #xf03f #xffff)
  315.   (#x0000 #x0400 #x0a00 #x0a00 #x0b40 #x0ab0 #x3aa8 #x4aa8 #x48a8 #x4008 #x4008 #x4008 #x4008 #x2010 #x1020 #x0fc0)))
  316. (HOURGLAS . (7 7
  317.   (#x8003 #x8003 #x8003 #x8003 #x8003 #x8003 #x8003 #x8823 #x8003 #x8003 #x8003 #x8003 #x8003 #x8003 #x8003 #xffff)
  318.   (#x7ffc #x3558 #x2aa8 #x3558 #x2aa8 #x2548 #x2288 #x2108 #x2288 #x2548 #x2aa8 #x3558 #x2aa8 #x3558 #x7ffc #x0000)))
  319. (KITE . (2 2
  320.   (#x87ff #x03ff #x03ff #x03ff #x03ff #x83ff #xf1ff #xf8ff #xfdff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  321.   (#x0000 #x7800 #x4800 #x4800 #x7800 #x0800 #x0400 #x0200 #x0000 #x0000 #x0000 #x0000 #x0000 #x0000 #x0000 #x0000)))
  322. (MESH . (0 0
  323.   (#xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  324.   (#xffff #xaaab #xd555 #xaaab #xd555 #xaaab #xd555 #xaaab #xd555 #xaaab #xd555 #xaaab #xd555 #xaaab #xd555 #xffff)))
  325. (SMALL . (0 0
  326.   (#xbfff #x1fff #x0fff #x07ff #x03ff #x01ff #x00ff #x01ff #x03ff #x01ff #xb0ff #xf0ff #xf9ff #xffff #xffff #xffff)
  327.   (#x0000 #x4000 #x6000 #x7000 #x7800 #x7c00 #x7e00 #x7c00 #x7800 #x4c00 #x0600 #x0600 #x0000 #x0000 #x0000 #x0000)))
  328. (SQUARE . (0 0
  329.   (#xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  330.   (#xffff #x8001 #x8001 #x8001 #x8001 #x8001 #x8001 #x8001 #x8001 #x8001 #x8001 #x8001 #x8001 #x8001 #x8001 #xffff)))
  331. (STAR4 . (7 7
  332.   (#xfe7f #xfc3f #xfc3f #xfc3f #xf81f #xf00f #x8001 #x0000 #x0000 #x8001 #xf00f #xf81f #xfc3f #xfc3f #xfc3f #xfe7f)
  333.   (#x0000 #x0180 #x0180 #x0180 #x03c0 #x03c0 #x0e70 #x7c3e #x7c3e #x0e70 #x03c0 #x03c0 #x0180 #x0180 #x0180 #x0000)))
  334. (TEXT . (5 7
  335.   (#xc63f #x801f #x000f #xb0df #xf0ff #xf0ff #xf0ff #xf0ff #xf0ff #xf0ff #xb0df #x000f #x801f #xc63f #xffff #xffff)
  336.   (#x0000 #x39c0 #x4620 #x0600 #x0600 #x0600 #x0600 #x0600 #x0600 #x0600 #x0600 #x4620 #x39c0 #x0000 #x0000 #x0000)))
  337. (X . (5 6
  338.   (#x1f8f #x0f0f #x060f #x000f #x801f #xc03f #xe07f #xc03f #x801f #x000f #x060f #x0f0f #x1f8f #xffff #xffff #xffff)
  339.   (#x0000 #x4020 #x6060 #x30c0 #x1980 #x0f00 #x0600 #x0f00 #x1980 #x30c0 #x6060 #x4020 #x0000 #x0000 #x0000 #x0000)))
  340.  
  341. ; the following are reproduced from MCD (mouse cursor designer)
  342. ; without permission
  343. (BEAKER . (1 2
  344.   (#xffff #x0001 #x0000 #x8000 #xc000 #xc000 #xc000 #xc000 #xc000 #xc000 #xc000 #xc000 #xc000 #xc000 #xe001 #xf003)
  345.   (#x0000 #x0000 #x7ffe #x3ffe #x1ffe #x1ffe #x1fc2 #x1602 #x1002 #x1002 #x1002 #x1002 #x1002 #x1002 #x0ffc #x0000)))
  346. (BULLSEYE . (7 8
  347.   (#xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  348.   (#x0000 #x07e0 #x0810 #x13c8 #x2424 #x2994 #x4a52 #x524a #x542a #x524a #x4a52 #x2994 #x2424 #x13c8 #x0810 #x07e0)))
  349. (CALIPERS . (7 14
  350.   (#xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  351.   (#x0000 #x0180 #x0240 #x0180 #x0180 #x0240 #x0240 #x0420 #x0810 #x1008 #x2004 #x2004 #x2004 #x1008 #x0c30 #x0000)))
  352. (CLOCK . (7 7
  353.   (#xe01f #xe01f #xe01f #xc00f #x8007 #x0003 #x0003 #x0001 #x0003 #x0003 #x8007 #xc00f #xe01f #xe01f #xe01f #xffff)
  354.   (#x0000 #x0fc0 #x0fc0 #x1020 #x2110 #x4108 #x4108 #x410c #x4208 #x4408 #x2010 #x1020 #x0fc0 #x0fc0 #x0000 #x0000)))
  355. (CRAYON . (1 1
  356.   (#x0fff #x07ff #x03ff #x01ff #x80ff #xc07f #xe03f #xf01f #xf80f #xfc07 #xfe03 #xff01 #xff83 #xffc7 #xffef #xffff)
  357.   (#x0000 #x7000 #x6800 #x5400 #x2200 #x1100 #x0880 #x0440 #x0220 #x0110 #x0088 #x0054 #x0028 #x0010 #x0000 #x0000)))
  358. (CROSSHAIR . (8 7
  359.   (#xff7f #xfe3f #xfe3f #xfe3f #xfe3f #xff7f #xc3e1 #x81c0 #xc3e1 #xff7f #xfe3f #xfe3f #xfe3f #xfe3f #xff7f #xffff)
  360.   (#x0000 #x0080 #x0080 #x0080 #x0080 #x0000 #x0000 #x3c1e #x0000 #x0000 #x0080 #x0080 #x0080 #x0080 #x0000 #x0000)))
  361. (CROSS . (7 8
  362.   (#xffff #xf01f #xf01f #xf01f #xf01f #x0001 #x0001 #x0001 #x0001 #x0001 #x0001 #x0001 #xf01f #xf01f #xf01f #xf01f)
  363.   (#x0000 #x0fe0 #x0820 #x0ba0 #x0ba0 #xfbbe #x8382 #xbffa #xbffa #xbffa #x8382 #xfbbe #x0ba0 #x0ba0 #x0820 #x0fe0)))
  364. (DISK . (7 14
  365.   (#x0003 #x0003 #x0003 #x0003 #x0003 #x0003 #x0003 #x0003 #x0003 #x0003 #x0003 #x0003 #x0003 #x0003 #x0003 #x0003)
  366.   (#x0000 #x7ff8 #x4008 #x4008 #x4008 #x4008 #x4308 #x4788 #x4308 #x4008 #x4308 #x4308 #x4308 #x4008 #x7ff8 #x0000)))
  367. (ERASER . (3 12
  368.   (#xff8f #xff07 #xfe03 #xfc01 #xf800 #xf001 #xe003 #xc007 #x800f #x001f #x003f #x807f #xc0ff #xe1ff #xf3ff #xffff)
  369.   (#x0000 #x0070 #x00a8 #x0114 #x020e #x0414 #x0828 #x1050 #x20a0 #x4140 #x6280 #x3500 #x1e00 #x0c00 #x0000 #x0000)))
  370. (FINGER . (5 0
  371.   (#xffff #xf3ff #xe1ff #xe1ff #xe1ff #xe1ff #xe007 #xe000 #x8000 #x0000 #x0000 #x0000 #x0000 #x0000 #x8001 #xc003)
  372.   (#x0000 #x0c00 #x1200 #x1200 #x1200 #x13b0 #x124e #x1249 #x7249 #x9249 #x9001 #x8001 #x8001 #x8001 #x4002 #x3ffc)))
  373. (GUNSIGHT . (8 7
  374.   (#xffff #xffff #xfc9f #xf80f #xf007 #xe003 #xe003 #xf007 #xe003 #xe003 #xf007 #xf80f #xfc9f #xffff #xffff #xffff)
  375.   (#x0080 #x0080 #x03e0 #x0490 #x0888 #x1084 #x1004 #x7c9f #x1004 #x1084 #x0888 #x0490 #x03e0 #x0080 #x0080 #x0000)))
  376. (HAIRS . (7 7
  377.   (#xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  378.   (#x0000 #x0000 #x0fe0 #x1110 #x2108 #x4104 #x4004 #x7c7c #x4004 #x4104 #x2108 #x1110 #x0fe0 #x0000 #x0000 #x0000)))
  379. (HUMAN . (7 6
  380.   (#xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  381.   (#x0000 #x0380 #x07c0 #x07c0 #x0380 #x0100 #x07c0 #x0540 #x0920 #x3118 #x0100 #x0280 #x0460 #x0418 #x0c00 #x0000)))
  382. (IBAR . (7 11
  383.   (#xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  384.   (#x0000 #x1c70 #x0280 #x0100 #x0100 #x0100 #x0100 #x0100 #x0100 #x0100 #x0100 #x07c0 #x0100 #x0280 #x1c70 #x0000)))
  385. (LASSO . (5 6
  386.   (#xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  387.   (#x0000 #x1f00 #x2080 #x4040 #x4040 #x8020 #x8020 #x80c0 #x4140 #x4140 #x2080 #x1f40 #x0020 #x0010 #x0008 #x0007)))
  388. (LLPOINT . (0 15
  389.   (#xfc03 #xf001 #xe000 #xc000 #x8000 #x8001 #xc001 #xc001 #xe021 #xf061 #xf0f0 #xe1f9 #xc3ff #x87ff #x0fff #x9fff)
  390.   (#x03fc #x0c02 #x1001 #x2401 #x4901 #x5242 #x2482 #x2922 #x1252 #x0c92 #x0909 #x1206 #x2400 #x4800 #x9000 #x6000)))
  391. (LRPOINT . (15 15
  392.   (#xc03f #x800f #x0007 #x0003 #x0001 #x8001 #x8003 #x8003 #x8407 #x860f #x0f0f #x9f87 #xffc3 #xffe1 #xfff0 #xfff9)
  393.   (#x3fc0 #x4030 #x8008 #x8024 #x8092 #x424a #x4124 #x4494 #x4a48 #x4930 #x9090 #x6048 #x0024 #x0012 #x0009 #x0006)))
  394. (ULPOINT . (0 0
  395.   (#x9fff #x0fff #x87ff #xc3ff #xe1f9 #xf0f0 #xf061 #xe021 #xc001 #xc001 #x8001 #x8000 #xc000 #xe000 #xf001 #xfc03)
  396.   (#x6000 #x9000 #x4800 #x2400 #x1206 #x0909 #x0c92 #x1252 #x2922 #x2482 #x5242 #x4901 #x2401 #x1001 #x0c02 #x03fc)))
  397. (URPOINT . (15 0
  398.   (#xfff9 #xfff0 #xffe1 #xffc3 #x9f87 #x0f0f #x860f #x8407 #x8003 #x8003 #x8001 #x0001 #x0003 #x0007 #x800f #xc03f)
  399.   (#x0006 #x0009 #x0012 #x0024 #x6048 #x9090 #x4930 #x4a48 #x4494 #x4124 #x424a #x8092 #x8024 #x8008 #x4030 #x3fc0)))
  400. (MOVE . (7 7
  401.   (#xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  402.   (#x0000 #x0100 #x0380 #x0540 #x0100 #x1110 #x2008 #x7c7c #x2008 #x1110 #x0100 #x0540 #x0380 #x0100 #x0000 #x0000)))
  403. (PAINTCAN . (13 14
  404.   (#xfeff #xfc7f #xf83f #xf01f #xe007 #xc003 #x8001 #x0001 #x8001 #xc001 #xe021 #xf061 #xf8e1 #xfde1 #xfff1 #xfffb)
  405.   (#x0000 #x0100 #x0280 #x0440 #x0820 #x1018 #x3ffc #x7ffc #x3fec #x1fcc #x0f8c #x070c #x020c #x000c #x0004 #x0000)))
  406. (PENCIL . (7 14
  407.   (#xf83f #xf01f #xf01f #xf01f #xf01f #xf01f #xf01f #xf01f #xf01f #xf01f #xf01f #xf01f #xf01f #xf83f #xfc7f #xfeff)
  408.   (#x0000 #x07c0 #x0440 #x0440 #x07c0 #x0440 #x0440 #x0440 #x0440 #x0440 #x0440 #x07c0 #x07c0 #x0380 #x0100 #x0000)))
  409. (PENCIL2 . (14 14
  410.   (#xefff #xc7ff #x83ff #x01ff #x80ff #xc07f #xe03f #xf01f #xf80f #xfc07 #xfe03 #xff01 #xff80 #xffc0 #xffe0 #xfff0)
  411.   (#x0000 #x1000 #x3800 #x7c00 #x3a00 #x1100 #x0880 #x0440 #x0220 #x0110 #x0088 #x0044 #x0022 #x0016 #x000e #x0000)))
  412. (PLIERS . (8 1
  413.   (#xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  414.   (#x0000 #x0180 #x03c0 #x03c0 #x03c0 #x0180 #x0180 #x0240 #x0420 #x0810 #x1008 #x1008 #x1008 #x1008 #x0810 #x0000)))
  415. (SCREWDRIVER . (1 14
  416.   (#xfff7 #xffe3 #xffc1 #xff80 #xff01 #xfe03 #xfc07 #xfe0f #xfc1f #xf8bf #xf1ff #xe3ff #xc7ff #x8fff #x1fff #x3fff)
  417.   (#x0000 #x0008 #x001c #x003e #x007c #x00f8 #x01f0 #x00e0 #x0140 #x0200 #x0400 #x0800 #x1000 #x2000 #x4000 #x0000)))
  418. (SELECT . (7 8
  419.   (#xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff #xffff)
  420.   (#x0000 #x0000 #x7d7c #x4104 #x4104 #x4104 #x4104 #x0000 #x7c7c #x0000 #x4104 #x4104 #x4104 #x4104 #x7d7c #x0000)))
  421. (SWORD . (7 14
  422.   (#xfeff #xfc7f #xf83f #xf82f #xf007 #xe00f #xc01f #xe83f #xf83f #xf83f #xf83f #xf83f #xf83f #xf83f #xfc7f #xfeff)
  423.   (#x0000 #x0100 #x0380 #x0380 #x0390 #x0fe0 #x1380 #x0380 #x0380 #x0380 #x0380 #x0380 #x0380 #x0380 #x0100 #x0000)))
  424. (TEST . (8 7
  425.   (#xffff #xffff #xffff #xfc1f #xf88f #xf087 #xe083 #xef7b #xe083 #xf087 #xf88f #xfc1f #xffff #xffff #xffff #xffff)
  426.   (#x0000 #x0000 #x0000 #x0000 #x03e0 #x07f0 #x0ff8 #x0000 #x0ff8 #x07f0 #x03e0 #x0000 #x0000 #x0000 #x0000 #x0000)))
  427. (THE-BOOT . (14 13
  428.   (#x80ff #x007f #x007f #x007f #x007f #x007f #x007f #x007f #x007f #x007f #x003f #x0003 #x0001 #x0000 #x0001 #x8e03)
  429.   (#x0000 #x7f00 #x4100 #x4100 #x4100 #x4100 #x4100 #x4100 #x4100 #x4100 #x4100 #x40c0 #x403c #x5e02 #x71fc #x0000)))
  430. (SCISSORS . (6 7
  431.   (#xffff #xffff #xfff1 #x1fe0 #x07c0 #x81c0 #xe001 #xf80f #xf80f #xe001 #x81c0 #x07c0 #x1fe0 #xfff1 #xffff #xffff)
  432.   (#x0000 #x0000 #x0000 #x000e #xe011 #x3811 #x0e3e #x01c0 #x01c0 #x0e3e #x3811 #xe011 #x000e #x0000 #x0000 #x0000)))
  433.         )))
  434.   (if (symbol? symbol)
  435.       (set! (access query (procedure-environment mouse))
  436.     (assq symbol cursors))))
  437.